OCT-29-04 10:13 FROM = TELCORDIA LEGAL DEPT. ID : 1 7323383004 PAGE 24/33 



# ! /uar/local/bin/perl 

# COPYRIGHT (c) 1998 Bell Communications Research Inc., 

# AIL Rights Reserved* 
# 

# PROPRIETARY - BELLCORE AND AUTHORIZED CLIENTS ONI*Y. 
# 

# This document contains proprietary information that shall 

# be distributed or routed only within Bell Communications 

# Research (Bellcore), and its authorized clients, except 

# with written permission of Bellcore. 
# 

# $Id: getCovar.pl,v 1.2 1353/05/25 15:33:47 rmartija Exp rmartija $ 
# 

undef ; 

require ' ge topt s . pi ■ ; 

require 1 /u/rmartij a/neteizer/ scripts/math. pi ' / 

$usage = "Usage: n . $0 . " [-D] -d domain file\n\n M . 
"Options i \n" . 

11 -D debug mode\n M . 

" -d domain domain type (l^US, 2^Non-US) \n" . 

» file name of input file. The default is STDlN.\n\a" . 

"Example :\n" . 

» $o . ./data/ test, out\n" . 

" $0 -d 1 . ,/data/teat ,out\n H . 

■' $0 -D . ./data/test. out\n" . 

$0 -D -d2 - ./data/test, out\n\n" ; 



######»################ main program ############################ 
###########^##################################################### 

$x - &aetopts( 'drD 1 ); 

die n $ USAGE \n" unless ($x ne '•); 

die "$CrSAGE\n n unless $opt_d && $opt_d >= l $opt_d <=> 2; 

if { $opt_d == 1 ) { 
$domain ~ f US 1 ; 

} 

else { 

$domain = 'NONUS'; 

} 

$oldLoc - ' ' , 
$rows = 0; 
$COlS = 0; 

die n $CJSAGE\n" if< $#ARGV > 0 ) ; 

if< $#ARQV < 0 || $ARGV[0] eq ' - ' ) { 
$ItfPUT = STDIN; 

} 

else { 
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die 11 ERROR : cannot open $ARGV(0) \n" unless -r $ARGV[0]; 
op«an( INPUT, M < $ARGV[0]" ); 
$ INPUT = INPUT; 

} 

while { <$INPUT> ) { 

Chop ; 

next unless length <$_) > 0; 
©tokens ~ split ( '\t' ( $_ ) ; 
$locale = $ tokens [0] ; 

if { $locale ne $oldLoc ) { 
if ( $oldLoc ne " ) { 

%m = &getMeans{ $rows-l, Scols, *oiatrix ); 
print "$domain: $oldLoc\n" ; 
print "MEAN: " ; 

for( $i » 1; $i <= $cols; $i++ ) { 
printf »%.2f, $m{$i) ; 
print " ■ if( $i < $cols ); 
print »\n" if ( $i « $cole ),- 

} 

if{ $opt_D ) { 

print "ORIGINAL MATRIX ;\n" ; 

for{ $i ~ 1; $i <= $cols; $i++ ) { 

for( $j = 1; $j <= $cols; $j++ ) { 

printf "%l2.2f", $matrix{$j + ( <$i - 1) * $cols) } ; 
— - print" " " if { $j < $cols )"; 

print "\n" if( $j ™ $cols ); 

} 

} 

print "\n" ; 

} 

%S ~ fcgetCovarianceMatrix ( $rows-l, $cols, ♦matrix, *m ); 
if( $opt_t> ) { 

print "COVARIANCE MATRIX: \n" ; 
for( ?i o i; $i < & $cols/ $i++ ) { 

for{ $j = 1; $j <= $cols; $j++ ) { 

printf »%l2.2f'', $S{$j + ((Si - D * $cols> } ; 
print » M if ( $ j < $cols ) ; 
print "\n" if( $j $cols ) ; 

} 

} 

print M \n" ; 

} 

%I = &getJnverseMatrix< Scols, *s ); 
print "INVERSE OF COVAfclANCS MATRIX :\n" ; 
for( $i = 1; $i <= $cols,- $i++ ) { 

for( $j = 1? $j <» $cole; $j++ ) { 

printf »%i2.2f», $i{$j + (($i - l) * $cols)} ; 

print " " if( $j < $cols ); 

print »\n n if ( $j == $cols ); 

} 

} 

print "\n h ; 
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} 

$oldLoc = $locale; 
$row3 = ly 

$cols = ©tokens - 1; 

} 

fori $j » 1; $j <= $COlS; ) { 

$matrix{$j + ( ($rows - l) * $cola) } = $tokens[$j] * l.o ; 

} 

$rows++; 

} 

Close ( $INPUT ) unless S#ARGV < 0 I I $ARGV[0] eq '-»; 

%m = &aetMeans( $rows-l, $cols, *matrix ); 
print "$domain: $oldLoc\n" ; 
print "MEAN: n ,- 

for( ?i = 1; $i <= $cols; ) { 

printf "%.2f", $m{$i} ; 
print " " if( $i < Scols ); 
print »\n» if ( $i ~ $COls ); 

} 

if ( $opt D ) { 

print "ORIGINAL MATRIX; \n" ; 
- - for ( $i « 1; $i Scols; $i++ ) { - 
for( $j = l; $j <= Scols; $j++ ) { 

printf »%12.2f", $matrix{$j + < <$i - 1) * $cols) } ; 
print " M if( $j * Scols ); 
print "\n" if( $j Scols ); 

} 

} 

print "\n» ; 

} 

%S = fi^etCovarianceMatrix( $rows-l, $cols, "matrix, *m ); 
if( $opt_D ) { 

print "COVARIANCJS:\n" ; 

for{ $i * 1; $i <- $COls; $i++ ) { 

for( $j = 1; $j <= Scols; ) { 

printf "%12.2f», $S{?j + (($i - i) * Scols)} ; 
print w " if< $j < $cols ); 
print M \n" if ( Sj $cola ); 

} 

} 

print » \n" ; 

} 

%I = &getlnvereeMatrix( Scols, *s ),- 

print "INVERSE OF COVARIANCE MATRIX :\n" ; 
for( $i = 1; SI <«=■ Scols; $i++ ) { 

for( $j = 1; $j <=- Scols; $jf+ > { 

printf "%12.2f", $l{$j + ( ($i - 1) * $cols) } ; 

print » " if ( $ j < $cols ) ; 

print i*< $j ™ $cols ); 
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} 

} 
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